# Library
library(tidyverse)
library(readxl)
library(janitor)
library(seminr)
library(psych)
library(MVN)PLS-SEM demo: Young peopleβs perceived service quality and environmental performance of hybrid electric bus.
R you ready? Intro to SEM in R.
1 Sample study
- Journal article: Young peopleβs perceived service quality and environmental performance of hybrid electric bus.
- Author: Zial Haque and Tehjeeb Noor
- Article link: DOI link
- Download the dataset here
2 Libraries
3 Data
## data
case_data <- read_csv("data/e_bus_customer_satisfaction.csv") %>%
clean_names()
case_data_items <- case_data %>%
select(bt1:bt7, bd1:bd4, emp1:emp5, cs1:cs3, ep1:ep4, ls1:ls5)4 Exploratory factor analysis
4.1 Scree plot
## Scree plot using parallel analysis
fa.parallel(case_data_items, fa = "fa")
Parallel analysis suggests that the number of factors = 6 and the number of components = NA 4.2 Factor extraction
## Factor loading
bus_fa <- fa(r = case_data_items,
nfactors = 6,
rotate = "varimax")
print(bus_fa$loadings, sort = TRUE, cutoff = 0.4)
Loadings:
MR2 MR1 MR3 MR4 MR6 MR5
ls1 0.820
ls2 0.891
ls3 0.828
ls4 0.806
ls5 0.599
bt1 0.673
bt2 0.666
bt4 0.549
bt5 0.680
bt6 0.578
bt7 0.550
ep1 0.864
ep2 0.900
ep3 0.690
ep4 0.705
emp1 0.688
emp2 0.662
emp3 0.636
emp4 0.697
emp5 0.502
bd1 0.679
bd2 0.640
bd3 0.676
bd4 0.629
cs1 0.774
cs2 0.817
cs3 0.768
bt3 0.476
MR2 MR1 MR3 MR4 MR6 MR5
SS loadings 3.477 3.363 3.081 2.658 2.429 2.297
Proportion Var 0.124 0.120 0.110 0.095 0.087 0.082
Cumulative Var 0.124 0.244 0.354 0.449 0.536 0.6185 Partial-least square SEM
5.1 Specifying the measurement model
pls_mm_ebus <-
constructs(
composite("tangible", multi_items("bt", c(1:2, 5:7))),
composite("drivers_quality", multi_items("bd", 1:4)),
composite("empathy", multi_items("emp", 1:5)),
composite("env_perf", multi_items("ep", 1:4)),
composite("customer_sat", multi_items("cs", 1:3)),
composite("life_sat", multi_items("ls", 1:5))
)
plot(pls_mm_ebus)5.2 Specifying the structural model
pls_sm_ebus <-
relationships(
paths(from = c("tangible", "drivers_quality", "empathy", "env_perf"),
to = "customer_sat"),
paths(from = "customer_sat", to = "life_sat")
)
plot(pls_sm_ebus)5.3 Estimating PLS-SEM model
pls_model_ebus <-
estimate_pls(
data = case_data,
measurement_model = pls_mm_ebus,
structural_model = pls_sm_ebus
)
plot(pls_model_ebus)summary_pls_model_ebus <- summary(pls_model_ebus)
summary_pls_model_ebus
Results from package seminr (2.3.2)
Path Coefficients:
customer_sat life_sat
R^2 0.448 0.077
AdjR^2 0.440 0.074
tangible 0.179 .
drivers_quality 0.146 .
empathy 0.310 .
env_perf 0.237 .
customer_sat . 0.278
Reliability:
alpha rhoC AVE rhoA
tangible 0.830 0.880 0.595 0.831
drivers_quality 0.856 0.902 0.698 0.857
empathy 0.825 0.876 0.586 0.840
env_perf 0.920 0.944 0.808 0.926
customer_sat 0.941 0.962 0.895 0.944
life_sat 0.903 0.929 0.724 0.911
Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.55.4 Bootstraping PLS-SEM
## bootstrapping PLS-SEM model
boot_pls_model_ebus <- bootstrap_model(seminr_model = pls_model_ebus,
nboot = 1000)
## summary results
summary_boot_pls_model_ebus <- summary(boot_pls_model_ebus, alpha = 0.10)
summary_boot_pls_model_ebus$bootstrapped_paths Original Est. Bootstrap Mean Bootstrap SD
tangible -> customer_sat 0.179 0.183 0.062
drivers_quality -> customer_sat 0.146 0.144 0.070
empathy -> customer_sat 0.310 0.315 0.069
env_perf -> customer_sat 0.237 0.234 0.051
customer_sat -> life_sat 0.278 0.284 0.052
T Stat. 5% CI 95% CI
tangible -> customer_sat 2.889 0.079 0.283
drivers_quality -> customer_sat 2.088 0.033 0.258
empathy -> customer_sat 4.475 0.197 0.425
env_perf -> customer_sat 4.663 0.148 0.313
customer_sat -> life_sat 5.307 0.196 0.3715.5 Factor loadings
# DT::datatable(summary_boot_pls_model_ebus$bootstrapped_loadings %>% round(3))
summary_boot_pls_model_ebus$bootstrapped_loadings Original Est. Bootstrap Mean Bootstrap SD T Stat.
bt1 -> tangible 0.763 0.763 0.038 20.158
bt2 -> tangible 0.766 0.765 0.035 21.631
bt5 -> tangible 0.767 0.768 0.032 24.273
bt6 -> tangible 0.790 0.789 0.029 26.769
bt7 -> tangible 0.772 0.772 0.034 22.487
bd1 -> drivers_quality 0.834 0.834 0.021 39.259
bd2 -> drivers_quality 0.823 0.823 0.025 33.168
bd3 -> drivers_quality 0.858 0.857 0.017 50.856
bd4 -> drivers_quality 0.826 0.828 0.026 32.347
emp1 -> empathy 0.768 0.769 0.029 26.199
emp2 -> empathy 0.799 0.798 0.027 29.380
emp3 -> empathy 0.699 0.695 0.044 16.001
emp4 -> empathy 0.794 0.792 0.030 26.717
emp5 -> empathy 0.762 0.764 0.027 27.791
ep1 -> env_perf 0.905 0.903 0.018 49.194
ep2 -> env_perf 0.947 0.946 0.010 98.438
ep3 -> env_perf 0.875 0.875 0.021 40.860
ep4 -> env_perf 0.866 0.866 0.028 30.676
cs1 -> customer_sat 0.944 0.945 0.012 79.613
cs2 -> customer_sat 0.960 0.960 0.007 147.488
cs3 -> customer_sat 0.934 0.933 0.015 60.395
ls1 -> life_sat 0.874 0.872 0.024 36.979
ls2 -> life_sat 0.915 0.915 0.016 57.955
ls3 -> life_sat 0.885 0.885 0.028 31.177
ls4 -> life_sat 0.854 0.851 0.024 35.497
ls5 -> life_sat 0.711 0.707 0.051 13.982
5% CI 95% CI
bt1 -> tangible 0.699 0.822
bt2 -> tangible 0.702 0.818
bt5 -> tangible 0.715 0.817
bt6 -> tangible 0.736 0.831
bt7 -> tangible 0.713 0.823
bd1 -> drivers_quality 0.797 0.866
bd2 -> drivers_quality 0.780 0.862
bd3 -> drivers_quality 0.829 0.883
bd4 -> drivers_quality 0.783 0.868
emp1 -> empathy 0.714 0.811
emp2 -> empathy 0.751 0.837
emp3 -> empathy 0.620 0.762
emp4 -> empathy 0.741 0.836
emp5 -> empathy 0.718 0.806
ep1 -> env_perf 0.871 0.930
ep2 -> env_perf 0.929 0.960
ep3 -> env_perf 0.836 0.907
ep4 -> env_perf 0.816 0.908
cs1 -> customer_sat 0.924 0.962
cs2 -> customer_sat 0.949 0.970
cs3 -> customer_sat 0.907 0.955
ls1 -> life_sat 0.827 0.906
ls2 -> life_sat 0.887 0.938
ls3 -> life_sat 0.831 0.924
ls4 -> life_sat 0.810 0.886
ls5 -> life_sat 0.614 0.7765.6 Validity and reliability
# DT::datatable(summary_pls_model_ebus$reliability %>% round(3))
## Reliability measurment
summary_pls_model_ebus$reliability alpha rhoC AVE rhoA
tangible 0.830 0.880 0.595 0.831
drivers_quality 0.856 0.902 0.698 0.857
empathy 0.825 0.876 0.586 0.840
env_perf 0.920 0.944 0.808 0.926
customer_sat 0.941 0.962 0.895 0.944
life_sat 0.903 0.929 0.724 0.911
Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.55.7 Discriminant validity
## Fornell-Larcker criterion results
summary_pls_model_ebus$validity$fl_criteria tangible drivers_quality empathy env_perf customer_sat life_sat
tangible 0.772 . . . . .
drivers_quality 0.562 0.835 . . . .
empathy 0.377 0.524 0.765 . . .
env_perf 0.471 0.421 0.380 0.899 . .
customer_sat 0.489 0.509 0.544 0.500 0.946 .
life_sat 0.326 0.249 0.237 0.293 0.278 0.851
FL Criteria table reports square root of AVE on the diagonal and construct correlations on the lower triangle.5.7.1 VIF
summary_pls_model_ebus$vif_antecedentscustomer_sat :
tangible drivers_quality empathy env_perf
1.624 1.783 1.445 1.392
life_sat :
customer_sat
.